home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-ti-twenex.el.z / efs-ti-twenex.el
Encoding:
Text File  |  1998-05-21  |  11.7 KB  |  342 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-ti-twenex.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  Support for a TI lisp machine in Twenex emulation mode.
  9. ;; Author:       Jamie Zawinski <jwz@lucid.com>
  10. ;; Created:      Thu Dec 17 15:04:14 1992
  11. ;; Modified:     Sun Nov 27 18:43:17 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. (provide 'efs-ti-twenex)
  20. (require 'efs)
  21.  
  22. (defconst efs-ti-twenex-version
  23.   (concat (substring "$efs release: 1.15 $" 14 -2)
  24.       "/"
  25.       (substring "#Revision: 1.1 $" 11 -2)))
  26.  
  27. ;;;; ------------------------------------------------------------
  28. ;;;; Twenex support.
  29. ;;;; ------------------------------------------------------------
  30. ;;;  Written for an explorer in ti-twenex mode. Twenex is supposed to be just
  31. ;;;  MIT's name for tops-20, but an explorer emulating twenex is not the same
  32. ;;;  thing.
  33.  
  34. (defconst efs-ti-twenex-filename-regexp
  35.   (let* ((excluded-chars ":;<>.#\n\r\ta-z")
  36.      (token  (concat "[^" excluded-chars "]+"))
  37.      (token* (concat "[^" excluded-chars "]*")))
  38.     (concat "\\(" token ": *" "\\)?"            ; optional device
  39.         "<\\(" token "\\)?\\(\\." token "\\)*> *"    ; directory
  40.         "\\(" token* "." token* "\\|\\) *"        ; name and extension
  41.         "\\(\\. *-?\\([0-9]+\\|>\\)\\)?")))        ; version
  42.  
  43. ;;; The above isn't entirely accurate, because "/" can quote any character
  44. ;;; anywhere in a pathname.
  45.  
  46. (efs-defun efs-fix-path ti-twenex (path &optional reverse)
  47.   ;; Convert PATH from UNIX-ish to Twenex.  If REVERSE given then convert
  48.   ;; from Twenex to UNIX-ish.
  49.   (efs-save-match-data
  50.     (if reverse
  51.     (if (string-match
  52.          "^\\([^:]+:\\)? *\\([^:]+:\\)? *<\\([^>]*\\)> *\\(.*\\)$"
  53.          path)
  54.         (let (dir file)
  55.           ;; I don't understand how "devices" work, so I'm ignoring them.
  56.           ;; (if (match-beginning 2)
  57.           ;;     (setq device (substring path
  58.           ;;                             (match-beginning 2)
  59.           ;;                             (1- (match-end 2)))))
  60.           (if (match-beginning 3)
  61.           (setq dir
  62.             (substring path (match-beginning 3) (match-end 3))))
  63.           (if (match-beginning 4)
  64.           (setq file
  65.             (substring path (match-beginning 4) (match-end 4))))
  66.           (cond (dir
  67.              (setq dir (apply (function concat)
  68.                       (mapcar (function
  69.                            (lambda (char)
  70.                          (if (= char ?.)
  71.                              (vector ?/)
  72.                            (vector char))))
  73.                           dir)))
  74.              (if (string-match "^/" dir)
  75.              (setq dir (substring dir 1))
  76.                (setq dir (concat "/" dir)))))
  77.           (concat
  78.            ;; (and device ":") device (and device ":")
  79.            dir (and dir "/")
  80.            file))
  81.       (error "path %s didn't match ti-twenex syntax" path))
  82.       (let (dir file tmp)
  83.     ;; (if (string-match "^/[^:]+:" path)
  84.     ;;     (setq device (substring path 1
  85.     ;;                       (1- (match-end 0)))
  86.     ;;           path (substring path (match-end 0))))
  87.     (cond ((setq tmp (file-name-directory path))
  88.            (setq dir (apply (function concat)
  89.                 (mapcar (function
  90.                      (lambda (char)
  91.                        (if (= char ?/)
  92.                            (vector ?.)
  93.                          (vector char))))
  94.                     (substring tmp 0 -1))))
  95.            (if (string-match "^[.]" dir)
  96.            (setq dir (substring dir 1))
  97.          (setq dir (concat "." dir)))))
  98.     (setq file (file-name-nondirectory path))
  99.     (concat
  100.      ;; (and device ":") device (and device ":")
  101.      (and dir "<")
  102.      dir
  103.      (and dir  ">")
  104.      file)))))
  105.  
  106. ;; (efs-fix-path-for-twenex "/PUBLIC/ZMACS/ZYMURG.LISP.1")
  107. ;; (efs-fix-path-for-twenex "<PUBLIC.ZMACS>ZYMURG.LISP.1" t)
  108.  
  109. (efs-defun efs-fix-dir-path ti-twenex (dir-path)
  110.   ;; Convert path from UNIX-ish to Explorer ready for a DIRectory listing.
  111.   (cond ((string-equal dir-path "/")
  112.      (efs-fix-path 'ti-twenex "/~/" nil))
  113.     ((string-match "^/[-A-Z0-9_$]+:/" dir-path)
  114.      (error "Don't grok TWENEX \"devices\" yet."))
  115.     ((efs-fix-path 'ti-twenex dir-path nil))))
  116.  
  117. (defmacro efs-parse-ti-twenex-filename ()
  118.   ;; Extract the next filename from an Explorer dired-like listing.
  119.   (` (if (re-search-forward
  120.       efs-ti-twenex-filename-regexp
  121.       nil t)
  122.      (buffer-substring (match-beginning 0) (match-end 0)))))
  123.  
  124. (efs-defun efs-parse-listing ti-twenex
  125.   (host user dir path &optional switches)
  126.   ;; Parse the current buffer which is assumed to be a TWENEX directory
  127.   ;; listing, and return a hashtable as the result.
  128.   ;; HOST = remote host name
  129.   ;; USER = user name
  130.   ;; DIR = directory in as a full remote path
  131.   ;; PATH = directory in full efs path syntax
  132.   ;; SWITCHES = ls switches (not relevant here)
  133.   (let ((tbl (efs-make-hashtable))
  134.     file)
  135.     (goto-char (point-min))
  136.     (efs-save-match-data
  137.       (while (setq file (efs-parse-ti-twenex-filename))
  138.     ;; Explorer/Twenex listings might come out in absolute form.
  139.     (if (string-match "^[^>]*> *" file)
  140.         (setq file (substring file (match-end 0))))
  141.     (if (string-match "\\.\\(DIRECTORY\\|directory\\).[0-9]+$" file)
  142.         ;; deal with directories
  143.         (efs-put-hash-entry
  144.          (substring file 0 (match-beginning 0)) '(t) tbl)
  145.       (efs-put-hash-entry file '(nil) tbl)
  146.       (if (string-match "\\.[0-9]+$" file) ; deal with extension
  147.           ;; sans extension
  148.           (efs-put-hash-entry
  149.            (substring file 0 (match-beginning 0)) '(nil) tbl)))
  150.     (forward-line 1))
  151.       (efs-put-hash-entry "." '(t) tbl)
  152.       (efs-put-hash-entry ".." '(t) tbl))
  153.     tbl))
  154.  
  155. (efs-defun efs-really-file-p ti-twenex (file ent)
  156.   ;; Eliminates the version entries
  157.   (or (car ent) ; file-directory-p
  158.       (efs-save-match-data
  159.     (string-match "\\.[0-9]+$" file))))
  160.  
  161. (efs-defun efs-delete-file-entry ti-twenex (path &optional dir-p)
  162.   (let ((ignore-case (memq 'ti-twenex efs-case-insensitive-host-types)))
  163.     (if dir-p
  164.     (let ((path (file-name-as-directory path))
  165.           files)
  166.       (efs-del-hash-entry path efs-files-hashtable ignore-case)
  167.       (setq path (directory-file-name path)
  168.         files (efs-get-hash-entry (file-name-directory path)
  169.                            efs-files-hashtable
  170.                            ignore-case))
  171.       (if files
  172.           (efs-del-hash-entry (efs-get-file-part path)
  173.                        files ignore-case)))
  174.       (efs-save-match-data
  175.     (let ((file (efs-get-file-part path)))
  176.       (if (string-match "\\.[0-9]+$" file)
  177.           ;; Only delete versions with explicit version numbers.
  178.           (let ((files (efs-get-hash-entry
  179.                 (file-name-directory path)
  180.                 efs-files-hashtable ignore-case)))
  181.         (if files
  182.             (let ((root (substring file 0
  183.                        (match-beginning 0)))
  184.               (completion-ignore-case ignore-case)
  185.               (len (match-beginning 0)))
  186.               (efs-del-hash-entry file files ignore-case)
  187.               ;; Now we need to check if there are any
  188.               ;; versions left. If not, then delete the
  189.               ;; root entry.
  190.               (or (all-completions
  191.                root files
  192.                (function
  193.                 (lambda (sym)
  194.                   (string-match "\\.[0-9]+$"
  195.                         (symbol-name sym) len))))
  196.               (efs-del-hash-entry root files
  197.                           ignore-case)))))))))
  198.     (efs-del-from-ls-cache path t ignore-case)))
  199.  
  200. (efs-defun efs-add-file-entry ti-twenex
  201.   (path dir-p size owner &optional modes nlinks mdtm)
  202.   ;; The ti-twenex version of this function needs to keep track
  203.   ;; of ti-twenex's file versions.
  204.   (let ((ignore-case (memq 'ti-twenex efs-case-insensitive-host-types))
  205.     (ent (let ((dir-p (null (null dir-p))))
  206.            (if mdtm
  207.            (list dir-p size owner nil nil mdtm)
  208.          (list dir-p size owner)))))
  209.     (if dir-p
  210.     (let* ((path (directory-file-name path))
  211.            (files (efs-get-hash-entry  (file-name-directory path)
  212.                         efs-files-hashtable
  213.                         ignore-case)))
  214.       (if files
  215.           (efs-put-hash-entry (efs-get-file-part path)
  216.                        ent files ignore-case)))
  217.       (let ((files (efs-get-hash-entry
  218.             (file-name-directory path)
  219.             efs-files-hashtable ignore-case)))
  220.     (if files
  221.         (let ((file (efs-get-file-part path)))
  222.           (efs-save-match-data
  223.         (if (string-match "\\.[0-9]+$" file)
  224.             (efs-put-hash-entry
  225.              (substring file 0 (match-beginning 0))
  226.              ent files ignore-case)
  227.           ;; Need to figure out what version of the file
  228.           ;; is being added.
  229.           (let* ((completion-ignore-case ignore-case)
  230.              (len (length file))
  231.              (versions (all-completions
  232.                     file files
  233.                     (function
  234.                      (lambda (sym)
  235.                        (string-match "\\.[0-9]+$"
  236.                              (symbol-name sym) len)))))
  237.              (N (1+ len))
  238.              (max (apply
  239.                    'max
  240.                    (cons 0 (mapcar
  241.                     (function
  242.                      (lambda (x)
  243.                        (string-to-int (substring x N))))
  244.                     versions)))))
  245.             ;; No need to worry about case here.
  246.             (efs-put-hash-entry
  247.              (concat file "." (int-to-string (1+ max))) ent files))))
  248.           (efs-put-hash-entry file ent files ignore-case)))))
  249.     (efs-del-from-ls-cache path t ignore-case)))
  250.  
  251. (efs-defun efs-internal-file-name-as-directory ti-twenex (name)
  252.   (efs-save-match-data
  253.     (if (string-match "\\.\\(DIRECTORY\\|directory\\)\\(\\.[0-9>]\\)?$" name)
  254.     (setq name (substring name 0 (match-beginning 0))))
  255.     (let (file-name-handler-alist)
  256.       (file-name-as-directory name))))
  257.  
  258. (efs-defun efs-allow-child-lookup ti-twenex (host user dir file)
  259.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  260.   ;; according to its file-name syntax, and therefore a child listing should
  261.   ;; be attempted.
  262.  
  263.   ;; Subdirs in TI-TWENEX can't have an extension (other than .DIRECTORY,
  264.   ;; which we have truncated).
  265.   (not (string-match "\\." file)))
  266.  
  267. ;;; Tree Dired
  268.  
  269. (defconst efs-dired-ti-twenex-re-dir
  270.   "^. *[^>\n\r]+>[^>\n\r.]+\\.\\(DIRECTORY\\|directory\\)\\b"
  271.   "Regular expression to use to search for TWENEX directories.")
  272.  
  273. (or (assq 'ti-twenex efs-dired-re-dir-alist)
  274.     (setq efs-dired-re-dir-alist
  275.       (cons (cons 'ti-twenex  efs-dired-ti-twenex-re-dir)
  276.         efs-dired-re-dir-alist)))
  277.  
  278. (efs-defun efs-dired-manual-move-to-filename ti-twenex
  279.   (&optional raise-error bol eol)
  280.   ;; In dired, move to first char of filename on this line.
  281.   ;; Returns position (point) or nil if no filename on this line.
  282.   ;; This is the Twenex version.
  283.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  284.   (let (case-fold-search)
  285.     (if bol
  286.     (goto-char bol)
  287.       (skip-chars-backward "^\n\r"))
  288.     (if (re-search-forward efs-ti-twenex-filename-regexp eol t)
  289.     (progn
  290.       (goto-char (match-beginning 0))
  291.       ;; Twenex listings might come out in absolute form.
  292.       (if (looking-at "[^>]*> *")
  293.           (goto-char (match-end 0))
  294.         (point)))
  295.       (and raise-error (error "No file on this line")))))
  296.  
  297. (efs-defun efs-dired-manual-move-to-end-of-filename ti-twenex
  298.   (&optional no-error bol eol)
  299.   ;; Assumes point is at beginning of filename.
  300.   ;; So, it should be called only after (dired-move-to-filename t).
  301.   ;; On failure, signals an error or returns nil.
  302.   ;; This is the Explorer version.
  303.   (let (case-fold-search)
  304.     (and selective-display
  305.      (null no-error)
  306.      (eq (char-after
  307.           (1- (or bol (save-excursion
  308.                 (skip-chars-backward "^\r\n")
  309.                 (point)))))
  310.          ?\r)
  311.      ;; File is hidden or omitted.
  312.      (cond
  313.       ((dired-subdir-hidden-p (dired-current-directory))
  314.        (error
  315.         (substitute-command-keys
  316.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  317.       ((error
  318.         (substitute-command-keys
  319.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  320.          )))))
  321.     (if (looking-at efs-ti-twenex-filename-regexp)
  322.     (goto-char (match-end 0))
  323.       (if no-error
  324.       nil
  325.     (error "No file on this line")))))
  326.  
  327. (efs-defun efs-internal-file-name-sans-versions ti-twenex
  328.   (name &optional keep-backup-version)
  329.   (efs-save-match-data
  330.     (if (string-match "\\.[0-9]+$" name)
  331.     (substring name 0 (match-beginning 0))
  332.       name)))
  333.  
  334. ;;; ### still need to ape these from vms:
  335. ;;;  efs-dired-vms-clean-directory
  336. ;;;  efs-dired-vms-collect-file-versions
  337. ;;;  efs-dired-vms-trample-file-versions
  338. ;;;  efs-dired-vms-flag-backup-files
  339. ;;;  efs-dired-vms-backup-diff
  340.  
  341. ;;; end of efs-ti-twenex.el
  342.